home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happysrc / pcetc.c < prev    next >
Text File  |  1993-11-30  |  15KB  |  369 lines
  1. /**********************************************************************
  2.  *
  3.  *              ***   HAPPy Pascal compiler ***
  4.  *                    各種サブルーチン群
  5.  *
  6.  *      void skip(Set fsys)
  7.  *      void updatelc(int upsize)
  8.  *      void getbounds(stp *fsp,long *fmin, long *fmax)
  9.  *      boolean equalbounds(stp *fsp1, stp *fsp2)
  10.  *      int align(stp *fsp,int flc)
  11.  *      void constant(Set fsys, stp **fsp, union valu *fvalu) 
  12.  *      boolean compatible(stp *fsp1,stp *fsp2)
  13.  *      boolean assigncompati(stp *fsp1,stp *fsp2)
  14.  *      boolean string(stp *fsp) ;
  15.  *
  16.  *                Copyright (c) H.Asano 1992
  17.  *
  18.  **********************************************************************/
  19.  
  20. #define EXTERN extern
  21. #include <string.h>
  22. #include "pascomp.h"
  23.  
  24. typedef enum _sign {none, pos, neg } signflag ;
  25.  
  26. boolean string(stp*)       ;
  27. static int alignquot(stp*) ;
  28. static void conststrings(stp**, union valu*) ; 
  29. static void constident(signflag,stp**, union valu*) ; 
  30. extern void pcerr(int,char*) ;
  31. extern void insymbol(void) ;
  32. extern ctp  *searchid(Set) ;
  33. extern Set  *mkset(Set*,int,...) ;
  34. extern Set  *orset(Set*,Set*)    ;
  35. extern void term(void) ; 
  36. extern void *Malloc(int) ;
  37. extern void applied(ctp*,int) ;
  38.  
  39.  
  40. /**************************************/
  41. /* skip() : 誤り回復のためにsymbolを  */
  42. /*          キーにして読み飛ばす      */
  43. /**************************************/
  44. void skip(Set fsys)
  45. {
  46.      while(! inset(fsys,sy))
  47.       insymbol() ;
  48. }
  49.  
  50. /**************************************/
  51. /* updatelc() : location counter更新  */
  52. /**************************************/
  53. void updatelc(int upsize)
  54. {
  55.        if(Maxaddr-upsize < lc)
  56.         pcerr(609,"") ;                 /* 変数割当できない           */
  57.        else lc += upsize ;              /* lc を更新                  */
  58. }
  59.  
  60. /*******************************************************/
  61. /* getbounds() : 範囲型,文字型,整数型､集合型,列挙型の  */
  62. /*               下限､上限値を求める                   */
  63. /*  (* assume fsp<>intptr and fsp<>realptr *)          */
  64. /*******************************************************/
  65. void getbounds(stp *fsp,long *fmin, long *fmax)
  66. {
  67.      if(!fsp) return ;
  68.  
  69.      if(fsp == charptr) {               /* 文字型                     */
  70.       *fmin = ordminchar          ;     /*   一番小さい文字コード     */
  71.       *fmax = ordmaxchar          ;     /*   一番大きい文字コード     */
  72.      }
  73.      else if(fsp == intptr) {           /* 整数型                     */
  74.       *fmin = -Maxint ;                 /*   -Maxint .. Maxint        */
  75.       *fmax =  Maxint ;
  76.      }
  77.      else if(fsp->form == subrange) {   /* 範囲型                     */
  78.       *fmin = fsp->sf.su.min      ;     /*  下限                      */
  79.       *fmax = fsp->sf.su.max      ;     /*  上限                      */
  80.      }
  81.      else if(fsp->form == power) {      /* 集合型                     */
  82.       *fmin = fsp->sf.pw.elmin   ;      /* 下限                       */
  83.       *fmax = fsp->sf.pw.elmax   ;      /* 上限                       */
  84.      }
  85.      else if(fsp->sf.sc.fconst) {       /* 列挙型の時                 */
  86.       *fmax = fsp->sf.sc.fconst->n.values.ival ; /* 最後の列挙名の値  */
  87.       *fmin = 0 ;
  88.      }
  89. }
  90.  
  91. /****************************************/
  92. /* equalbounds() : 2つの型の上限､下限が */
  93. /*                 等しいか判定する     */
  94. /****************************************/
  95. boolean equalbounds(stp *fsp1, stp *fsp2)
  96. {
  97.   long lmin1,lmin2,lmax1,lmax2 ;
  98.  
  99.      if((!fsp1) || (!fsp2)) return(true) ;  /* 今のところ意味不明     */
  100.  
  101.      getbounds(fsp1,&lmin1,&lmax1) ;    /* fsp1 の下限､上限を調べる   */
  102.      getbounds(fsp2,&lmin2,&lmax2) ;    /* fsp2 の下限､上限を調べる   */
  103.      return((lmin1==lmin2) && (lmax1==lmax2)) ;/* 両方とも等しいとき真*/
  104. }
  105.  
  106. /************************************************/
  107. /* align() : 型に応じた割りつけ開始番地を求める */
  108. /*            flc    : 今の番地                 */
  109. /*            return : 割りつけ開始番地         */
  110. /************************************************/
  111. int align(stp *fsp,int flc)
  112. {
  113.   int k, l;
  114.  
  115.      k = alignquot(fsp) ;               /* その型の境界値を求める     */
  116.      l = flc - 1 + k    ;               /* flc以上の最小のkの公倍数を */
  117.      return(l - l%k)    ;               /* 返却する                   */ 
  118. }
  119.  
  120. /**************************************/
  121. /* alignquot() : 型の境界を求める     */
  122. /*     align の 内部関数              */
  123. /**************************************/
  124. static int alignquot(stp *fsp)
  125. {
  126.      if(!fsp) return(1) ;               /* 型ポインタがない時は1      */
  127.  
  128.      switch(fsp->form) {
  129.       case scalar   :                   /* スカラー型    */   
  130.              if(fsp==intptr)  return(intal)  ;           /* integer型     */ 
  131.              if(fsp==boolptr) return(boolal) ;           /* boolean型     */
  132.              if(fsp==charptr) return(charal) ;           /* char   型     */
  133.              if(fsp==realptr) return(realal) ;           /* real   型     */
  134.              if(fsp->sf.sc.scalkind == declared)         /* 列挙   型     */ 
  135.                               return(intal)  ;           
  136.              return(parmal) ;                            /* parameter list*/
  137.       case subrange :                   /* 範囲型        */
  138.              return(alignquot(fsp->sf.su.rangetype)) ;   /* 範囲の元の型  */
  139.       case pointer  :                   /* ポインタ型    */
  140.              return(adral)  ;
  141.       case power    :                   /* 集合型        */
  142.              return(setal)  ;
  143.       case files    :                   /* ファイル型    */
  144.              return(fileal) ;
  145.       case arrays   :                   /* 配列型        */
  146.              return(alignquot(fsp->sf.ar.aeltype)) ;
  147.                                         /* 要素の型      */
  148.       case records  :                   /* レコード      */
  149.              return(recal)  ;
  150. /*    case variant  : */                /* 可変レコード  */
  151. /*    case tagfld   : */                /* 可変レコードのタグ名 */
  152.                                         /* このルートはない     */
  153.      }
  154. }
  155.  
  156. /*********************************************/
  157. /*     constant() : 定数の処理               */
  158. /*********************************************/
  159. void constant(Set fsys, stp **fsp, union valu *fvalu) 
  160. {
  161.   stp *lsp ;
  162.   signflag sign ;
  163.   Set ws ;
  164.  
  165.      lsp = nil ;
  166.      (*fvalu).ival = 0 ;
  167.  
  168.      if(! inset(constbegsys,sy)) {    /* 定数として許されない時  */
  169.       pcerr(50,"") ;                  /*  定数に誤りがある       */
  170.       ws = fsys                 ;
  171.       orset(&ws,&constbegsys)   ;
  172.       skip(ws)                  ;     /* fsys+constbegsysまでskip*/
  173.      }
  174.  
  175.      if(inset(constbegsys,sy)) {      /* 定数としてOKの時        */
  176.       if(sy == stringconst)           /*   文字列定数の時        */
  177.        conststrings(fsp,fvalu)  ;     /*   文字列定数の処理      */
  178.       else {
  179.      /***  文字列以外の時は まず符号(+ -)の処理をする ***/
  180.  
  181.        sign = none ;
  182.        if((op == plus) || (op == minus)) {  /* + - の 時          */
  183.         sign = (op == plus) ? pos : neg ;   /*  符号の選別        */
  184.         insymbol() ;
  185.        }
  186.  
  187.        if(sy == ident)                  /* 名前の時                   */
  188.         constident(sign,fsp,fvalu) ;    /* 名前定数の処理             */  
  189.  
  190.        else if(sy == intconst) {        /* 整数定数の時               */
  191.  
  192.         if(sign == neg) val.ival = -val.ival ; /* -の時は値を反転 */
  193.         *fsp   = intptr     ;
  194.         *fvalu = val        ;
  195.         insymbol()          ;
  196.        }
  197.  
  198.        else if(sy == realconst) {       /* 実数定数の時               */
  199.         if(sign == neg)
  200.         *(val.valp->c.rval) = '-' ;     /*  頭に負の符号をつける      */
  201.         *fsp = realptr      ;
  202.         *fvalu = val        ;
  203.         insymbol()          ;
  204.        }
  205.  
  206.        else {                           /* それ以外                   */
  207.         pcerr(106,"") ;                 /* 数がない                   */
  208.         skip(fsys)    ;  
  209.        }
  210.       }
  211.      }
  212.  
  213.      if(! inset(fsys,sy)) {
  214.       pcerr(6,"") ;                     /* 不当な記号が現れた */
  215.       skip(fsys)  ;
  216.      }
  217. }
  218.  
  219. /***************************************/
  220. /* conststrings():  文字列定数の処理   */
  221. /***************************************/
  222. static void conststrings(stp **fsp, union valu *fvalu) 
  223. {
  224.   stp *lsp,*lsp1 ;
  225.  
  226.      if(lgth == 1)      lsp = charptr ; /*   1文字は文字型            */
  227.      else if(lgth == 0) lsp = nil ;     /*   0文字はエラー            */
  228.      else {
  229.       lsp = (stp*)Malloc(sizeof(stp));
  230.       lsp->size = lgth*charsize ;       /* 文字列長                   */
  231.       lsp->form = arrays ;              /* 配列型                     */
  232.       lsp->sf.ar.packed  = true    ;    /* 詰め込み型である           */
  233.       lsp->sf.ar.aeltype = charptr ;    /*  要素の型は文字型          */
  234.       lsp1 = (stp*)Malloc(sizeof(stp)) ;/*  添字の型は                */
  235.       lsp1->form = subrange          ;  /*        範囲型              */
  236.       lsp1->size = intsize           ;
  237.       lsp1->sf.su.rangetype = intptr ;
  238.       lsp1->sf.su.min = 1            ;  /*  添字の下限値は1           */
  239.       lsp1->sf.su.max = (long)lgth   ;  /*  添字の上限値は文字列長    */
  240.       lsp->sf.ar.inxtype = lsp1      ;  /*  添字の型をこの範囲型とする*/
  241.      }
  242.      *fvalu = val ;                     /*  文字列を返却              */
  243.      *fsp   = lsp ;
  244.      insymbol()   ;
  245. }
  246.  
  247. /***************************************/
  248. /* constident():  名前定数の処理       */
  249. /***************************************/
  250. static void constident(signflag fsign,stp **fsp, union valu *fvalu) 
  251. {
  252.   stp *lsp ;
  253.   ctp *lcp ;
  254.   csp *lvp ;
  255.   int i    ;
  256.   Set ws ;
  257.  
  258.      mkset(&ws, konst, -1)   ;
  259.      lcp = searchid(ws)      ;          /* 定数の名前から探す         */
  260.      applied(lcp,level)      ;          /* 参照名チェーン             */
  261.      lsp = lcp->idtype       ;           
  262.      *fvalu = lcp->n.values  ;          /* 名前の値                   */
  263.      if(fsign != none) {                /* 符号がある時               */
  264.       if(lsp == intptr) {               /*  整数                      */
  265.        if(fsign == neg)
  266.         (*fvalu).ival = -(*fvalu).ival; /*  値を反転                  */
  267.       }
  268.       else if(lsp == realptr) {         /*  実数                      */
  269.        if(fsign == neg) {
  270.         lvp = (csp*)Malloc(sizeof(csp));
  271.         lvp->cclass = real ;
  272.         lvp->c.rval = (char*)Malloc(Maxdiglng+1+1);
  273.         *(lvp->c.rval) = ((*(*fvalu).valp->c.rval)=='-')/*  - * - = + */
  274.                           ? (char)' ' : (char)'-'  ;    /*  + * - = - */
  275.         strcpy(lvp->c.rval+1,
  276.               (*fvalu).valp->c.rval+1); /*  中身を移しかえ            */
  277.         (*fvalu).valp = lvp ;
  278.        }   
  279.       }
  280.       else   pcerr(105,lcp->name) ;     /*  整数や実数でないのに      */
  281.                                         /*  符号があるので、符号は駄目*/
  282.                                         /*  のエラーメッセージ        */
  283.      }
  284.      *fsp   = lsp ;
  285.      insymbol()   ;
  286. }
  287.  
  288. /********************************************/
  289. /* compatible() : 2つの型が適合するか判定   */
  290. /********************************************/
  291. boolean compatible(stp *fsp1,stp *fsp2)
  292. {
  293.  
  294.      if(fsp1 == fsp2) return(true) ;    /* 型のアドレスが同じなら等しい*/
  295.      
  296.      if((!fsp1) || (!fsp2)) return(true);
  297.                                         /* どちらかがnilならば､すでに
  298.                                           エラーメッセージが出ている
  299.                                           はずなので、ここでさらに
  300.                                           エラーを検出させないためtrue*/
  301.  
  302.      if(fsp1->form == fsp2->form)       /* 型が等しい                 */
  303.       switch(fsp1->form) {
  304.        case subrange : return           /* 部分範囲型                 */
  305.                       (fsp1->sf.su.rangetype == fsp2->sf.su.rangetype);
  306.                                         /*   両方が 同じ型            */
  307.                                         
  308.        case power    :                  /* 集合型                     */
  309.                       if((fsp1->sf.pw.packed == both) ||
  310.                          (fsp2->sf.pw.packed == both))
  311.                         return(compatible(fsp1->sf.pw.elset, /*基底の型*/ 
  312.                                           fsp2->sf.pw.elset )) ;/*のD適合*/
  313.                       else return
  314.                       (!(fsp1->sf.pw.packed ^ fsp2->sf.pw.packed) &&
  315.                                         /* 両方とも詰めなしか詰めあり */
  316.                        compatible(fsp1->sf.pw.elset,     /* 基底の型が*/
  317.                                   fsp2->sf.pw.elset )) ; /* 適合      */
  318.  
  319.        case pointer :  return           /* ポインタ型                 */
  320.                       ((fsp1 == nilptr) || (fsp2 == nilptr)) ; 
  321.                                         /*   nilは全てのﾎﾟｲﾝﾀ型と適合 */
  322.                                         
  323.        case arrays  :  return           /* 配列型                     */
  324.                       (string(fsp1) && string(fsp2) &&
  325.                         (fsp1->sf.ar.inxtype->sf.su.max ==
  326.                          fsp2->sf.ar.inxtype->sf.su.max));
  327.                                          /* 同数の成分を持つ文字列型の
  328.                                             時は適合する              */
  329.                                             
  330.        default       : return(false)  ; /* それ以外の型は不適合       */
  331.       }
  332.  
  333.      else if(fsp1->form == subrange)    /* fsp1がfsp2の部分範囲か     */
  334.       return (fsp1->sf.su.rangetype == fsp2) ;
  335.      else if(fsp2->form == subrange)    /* fsp2がfsp1の部分範囲か     */
  336.       return (fsp1 == fsp2->sf.su.rangetype) ;
  337.      else return(false) ;
  338. }
  339.  
  340. /***************************************************/
  341. /* assigncompati() : 2つの型の代入可能性を判定する */
  342. /*           型fsp1に対して型fsp2が代入可能の時真  */  
  343. /***************************************************/
  344. boolean assigncompati(stp *fsp1,stp *fsp2)
  345. {
  346.      if(fsp1 == fsp2)                   /* 同じ型                     */
  347.       return(fsp1->assignflag) ;        /* 代入可能性のチェック       */  
  348.      else if((fsp1 == realptr) && compatible(fsp2,intptr)) return(true) ;
  349.      else return(compatible(fsp1,fsp2)) ;
  350. }
  351.  
  352. /**************************************/
  353. /* string() : 型が文字列か判定する    */
  354. /**************************************/
  355. boolean string(stp *fsp)
  356. {
  357.      if(!fsp) return(false) ;
  358.  
  359.      if((fsp->form == arrays)                       /* 配列型         */
  360.      && (fsp->sf.ar.packed)                         /* packed指定あり */
  361.      && (compatible(fsp->sf.ar.aeltype,charptr))    /* 要素の型が文字型*/
  362.      && (fsp->sf.ar.inxtype->form == subrange)      /* 添字の型は範囲 */
  363.      && (fsp->sf.ar.inxtype->sf.su.min == 1)        /* 下限値は1      */
  364.      && (fsp->sf.ar.inxtype->sf.su.max >  1 ))      /* 上限値は2以上  */
  365.       return(true)     ;                /* その時 文字列と認められる  */
  366.      else return(false) ;               /* 上記以外は文字列ではない   */
  367. }
  368.  
  369.